{ *********************************************************** }
{ *                    ksTools Library                      * }
{ *       Copyright (c) Sergey Kasandrov 1997, 2010         * }
{ *       -----------------------------------------         * }
{ *         http://sergworks.wordpress.com/kstools          * }
{ *********************************************************** }

unit TestCompress;
{

  Delphi DUnit Test Case
  ----------------------
  This unit contains a skeleton test case class generated by the Test Case Wizard.
  Modify the generated code to correctly setup and call the methods from the unit
  being tested.

}

interface

uses
  TestFramework, Windows, Forms, Dialogs, Controls, Classes, SysUtils, Variants,
  Graphics, Messages, ksUtils, ksCompress, ksArchives, ksZip;

type
  TTestCompress = class(TTestCase)
  protected
    procedure CheckEqualBytes(const A, B: TBytes; const Comment: string = '');
  end;

  TTestCompressAll = class(TTestCompress)
  protected
    procedure TestShrinkASCII(const S: string);
    procedure TestFlateHuffmanASCII(const S: string);
//    procedure SetUp; override;
  published
    procedure TestShrinkA;
    procedure TestShrinkFile;
    procedure TestFlateHuffmanA;
    procedure TestFlateHuffmanFile;
  end;

  TTestZipCrypto = class(TTestCompress)
  protected
//    procedure SetUp; override;
    procedure TestASCII(const S, PassW: string; Check: Integer);
  published
    procedure TestZipCryptoA;
  end;

  TTestZip = class(TTestCase)
  protected
    procedure ListZip(const ZipName: string);
  published
    procedure TestZipOpen;
    procedure TestZipCreate;
  end;


implementation

function StringToBytes(const S: string): TBytes;
var
  I: Integer;

begin
  SetLength(Result, Length(S));
  for I:= 0 to Length(S) - 1 do begin
    Result[I]:= Byte(S[I + 1]);
  end;
end;
{
function CRC32Stream(AStream: TStream; Count: Integer = 0): LongWord;
var
  B: Byte;

begin
  if Count = 0 then
    Count:= AStream.Seek(0, soFromEnd);
  AStream.Seek(0, soFromBeginning);
  Result:= $FFFFFFFF;
  while Count > 0 do begin
    AStream.ReadBuffer(B, 1);
    Result:= CRC32OfByte(B, Result);
    Dec(Count);
  end;
end;
}
{ TestCompress }

procedure TTestCompress.CheckEqualBytes(const A, B: TBytes;
  const Comment: string);
var
  I: Integer;

begin
  CheckEquals(Length(A), Length(B),
      Format('%s Length: %d -- %d', [Comment, Length(A), Length(B)]));
  for I:= 0 to Length(A) - 1 do
    CheckEquals(Cardinal(A[I]), Cardinal(B[I]),
      Format('%s Data[%d]: %.4x -- %.4x', [Comment, I, A[I], B[I]]));
end;

{ TestCompressAll }

procedure TTestCompressAll.TestShrinkA;
begin
  TestShrinkASCII('abraabracadabra');
end;

procedure TTestCompressAll.TestShrinkFile;
var
  OriginalStream,
  CompressedStream,
  UnCompressedStream: TStream;
  Size, NewSize: Integer;
  CRC, NewCRC: LongWord;

begin
  OriginalStream:= TFileStream.Create('CompressTests.exe',
                                       fmOpenRead or fmShareDenyNone);
  try
    Size:= OriginalStream.Size;
    CompressedStream:= TMemoryStream.Create;
    try
      ShrinkStream(OriginalStream, CompressedStream, Size);
      CompressedStream.Seek(0, soFromBeginning);
      UnCompressedStream:= TMemoryStream.Create;
      try
        UnshrinkStream(CompressedStream, UncompressedStream, Size);
        NewSize:= UncompressedStream.Size;
        CheckEquals(Size, NewSize, Format('Size: %d -- %d', [Size, NewSize]));
        OriginalStream.Seek(0, soFromBeginning);
        CRC:= CRC32Stream(OriginalStream);
        UncompressedStream.Seek(0, soFromBeginning);
        NewCRC:= CRC32Stream(UncompressedStream);
        CheckEquals(CRC, NewCRC, Format('Size: %.8x -- %.8x', [CRC, NewCRC]));
      finally
        UnCompressedStream.Free;
      end;
    finally
      CompressedStream.Free;
    end;
  finally
    OriginalStream.Free;
  end;
end;

procedure TTestCompressAll.TestShrinkASCII(const S: string);
var
  OriginalBytes,
  CompressedBytes,
  UnCompressedBytes: TBytes;

begin
  OriginalBytes:= StringToBytes(S);
  CompressedBytes:= ShrinkBytes(OriginalBytes);
  UnCompressedBytes:= UnshrinkBytes(CompressedBytes, Length(OriginalBytes));
  CheckEqualBytes(OriginalBytes, UncompressedBytes);
end;

procedure TTestCompressAll.TestFlateHuffmanASCII(const S: string);
var
  OriginalBytes,
  CompressedBytes,
  UnCompressedBytes: TBytes;

begin
  OriginalBytes:= StringToBytes(S);
  CompressedBytes:= FlateHuffEncodeBytes(OriginalBytes);
  UnCompressedBytes:= FlateHuffDecodeBytes(CompressedBytes, Length(OriginalBytes));
  CheckEqualBytes(OriginalBytes, UncompressedBytes);
end;

procedure TTestCompressAll.TestFlateHuffmanA;
begin
  TestFlateHuffmanASCII('abraabracadabra');
end;

procedure TTestCompressAll.TestFlateHuffmanFile;
//const
//  MaxSize = 60 * 1024;

var
  OriginalStream,
  CompressedStream,
  UnCompressedStream: TStream;
  Size, NewSize: Integer;
  CRC, NewCRC: LongWord;

begin
  OriginalStream:= TFileStream.Create('CompressTests.exe',
                                       fmOpenRead or fmShareDenyNone);
  try
    Size:= OriginalStream.Size;
//    if Size > MaxSize then Size:= MaxSize;
    CompressedStream:= TMemoryStream.Create;
    try
      FlateHuffEncodeStream(OriginalStream, CompressedStream, Size);
      CompressedStream.Seek(0, soFromBeginning);
      UnCompressedStream:= TMemoryStream.Create;
      try
        FlateHuffDecodeStream(CompressedStream, UncompressedStream, Size);
        NewSize:= UncompressedStream.Size;
        CheckEquals(Size, NewSize, Format('Size: %d -- %d', [Size, NewSize]));
        CRC:= CRC32Stream(OriginalStream);
        NewCRC:= CRC32Stream(UncompressedStream);
        CheckEquals(CRC, NewCRC, Format('Size: %.8x -- %.8x', [CRC, NewCRC]));
      finally
        UnCompressedStream.Free;
      end;
    finally
      CompressedStream.Free;
    end;
  finally
    OriginalStream.Free;
  end;
end;

{ TTestZipCrypto }

procedure TTestZipCrypto.TestASCII(const S, PassW: string; Check: Integer);
var
  OriginalBytes,
  Password,
  EncryptedBytes,
  DecryptedBytes: TBytes;

begin
  OriginalBytes:= StringToBytes(S);
  Password:= StringToBytes(PassW);
  EncryptedBytes:= ZipEncryptBytes(OriginalBytes, PassWord, Check);
  DecryptedBytes:= ZipDecryptBytes(EncryptedBytes, PassWord, Check);
  CheckEqualBytes(OriginalBytes, DecryptedBytes);
end;

procedure TTestZipCrypto.TestZipCryptoA;
var
  Check: Integer;

begin
  for Check:= -1 to 2 do begin
    TestASCII('TEST_DATA', 'TEST_PASSW', Check);
  end;
end;

{ TTestZip }

procedure TTestZip.ListZip(const ZipName: string);
var
  Archive: TksArchive;
  ZipArchive: TksZipArchive;
  SL: TStringList;
  Info: TksArchive.TItemInfo;
  I: Integer;

begin
  Archive:= TksArchive.Create(nil);
  try
    Archive.Open(ZipName, fmOpenRead or fmShareDenyWrite);
    ZipArchive:= Archive.Archive as TksZipArchive;
    SL:= TStringList.Create;
    try

      SL.Add(Format('%s File List', [ZipName]));
      SL.Add('========================');
      for I:= 0 to Archive.ItemCount - 1 do begin
        if Archive.GetItemInfo(Info, I)
          then SL.Add(Info.FileName)
          else SL.Add('ERROR !');
      end;

      SL.Add('');
      SL.Add(Format('%s End of Central Directory Record', [ZipName]));
      SL.Add('==============================================');
      with ZipArchive.EndOfCentralDirRec^ do begin
        SL.Add(Format('Signature .......... $%.8x', [Signature]));
        SL.Add(Format('DiskNumber ......... %d', [DiskNumber]));
        SL.Add(Format('StartDiskNumber .... %d', [StartDiskNumber]));
        SL.Add(Format('EntriesOnDisk ...... %d', [EntriesOnDisk]));
        SL.Add(Format('TotalEntries ....... %d', [TotalEntries]));
        SL.Add(Format('DirectorySize ...... %d', [DirectorySize]));
        SL.Add(Format('DirectoryOffset .... %d', [DirectoryOffset]));
        SL.Add(Format('CommentLen ......... %d', [CommentLen]));
      end;

      SL.Add('');
      SL.Add(Format('%s Central Directory', [ZipName]));
      SL.Add('================================');
      for I:= 0 to Archive.ItemCount - 1 do begin
        SL.Add(Format('=== Item #%d ===', [I+1]));
        with ZipArchive.Items[I]^ do begin
          SL.Add(Format('Signature .......... $%.8x', [Signature]));
          SL.Add(Format('VersionMadeBy ...... %d', [VersionMadeBy]));
          SL.Add(Format('VersionToExtract ... %d', [VersionToExtract]));
          SL.Add(Format('Flags .............. $%.4x', [Flags]));
          SL.Add(Format('CompressionMethod .. %d', [CompressionMethod]));
          SL.Add(Format('LastModDateTime .... $%.8x', [LastModDateTime]));
          SL.Add(Format('CRC32 .............. $%.8x', [CRC32]));
          SL.Add(Format('CompressedSize ..... %d', [CompressedSize]));
          SL.Add(Format('UncompressedSize ... %d', [UncompressedSize]));
          SL.Add(Format('FileNameLen ........ %d', [FileNameLen]));
          SL.Add(Format('ExtraFieldLen ...... %d', [ExtraFieldLen]));
          SL.Add(Format('FileCommentLen ..... %d', [FileCommentLen]));
          SL.Add(Format('DiskNumberStart .... %d', [DiskNumberStart]));
          SL.Add(Format('InternalAttributes . $%.4x', [InternalAttributes]));
          SL.Add(Format('ExternalAttributes . $%.8x', [ExternalAttributes]));
          SL.Add(Format('RelativeOffset ..... %d [$%.8x]',
                         [RelativeOffset, RelativeOffset]));
        end;
        if Archive.GetItemInfo(Info, I) then begin
          SL.Add('--- Info ---');
          with Info do begin
            SL.Add(Format('CompressedSize ..... %d', [CompressedSize]));
            SL.Add(Format('Attributes ......... $%.8x', [Attributes]));
            SL.Add(FormatDateTime('"Date & Time ........" dddddd, hh.nn.ss.zzz',
                                   FileDate));
            SL.Add(Format('File Name .......... %s', [FileName]));
            SL.Add(Format('File Size .......... %d', [FileSize]));
          end;
        end;
        SL.Add('');
      end;

      SL.SaveToFile(ChangeFileExt(ZipName, '.LST'));
    finally
      SL.Free;
    end;
  finally
    Archive.Free;
  end;
end;

procedure TTestZip.TestZipCreate;
var
  Archive: TksArchive;
  ZipArchive: TksZipArchive;
  SL: TStringList;
  Info: TksArchive.TItemInfo;
  I: Integer;

begin
  Archive:= TksArchive.Create(nil);
  try
    Archive.Open('ks045.zip', fmCreate);
    ZipArchive:= Archive.Archive as TksZipArchive;
    Archive.AppendFile('ksTools045.zip');
    Archive.AppendFile('ksTools045.LST');
    Archive.ExtractFile(1, 'ksTools045.TXT');
    ZipArchive.FileEncrypted:= True;
    Archive.AppendFile('ksTools045.TXT');
    Archive.ExtractFile(2, 'ksTools045.LST');
    ZipArchive.FileEncrypted:= False;
    ZipArchive.CompressionMethod:= TksZipArchive.METHOD_SHRINK;
    Archive.AppendFile('ksTools045.LST', 'ksTools045.LS');
    Archive.ExtractFile(3, 'ksTools045.TXT');
    ZipArchive.FileEncrypted:= True;
    ZipArchive.FilePasswordString:= '123';
    Archive.AppendFile('ksTools045.TXT', 'ksTools045.TX');
    Archive.ExtractFile(4);
    Archive.Close;
//    Archive.Open('ks045.zip', fmOpenRead or fmShareDenyWrite);
{    SL:= TStringList.Create;
    try
      for I:= 0 to Archive.ItemCount - 1 do begin
        if Archive.GetItemInfo(Info, I)
          then SL.Add(Info.FileName)
          else SL.Add('ERROR !');
      end;
      SL.SaveToFile('ks045.lst');
    finally
      SL.Free;
    end;}
    ListZip('ks045.zip');
//    ListZip('ksTools.zip');
  finally
    Archive.Free;
  end;
end;

procedure TTestZip.TestZipOpen;
begin
  ListZip('ksTools045.zip');
end;

initialization
  // Register any test cases with the test runner
  RegisterTest(TTestCompressAll.Suite);
  RegisterTest(TTestZipCrypto.Suite);
  RegisterTest(TTestZip.Suite);
end.

